home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue46 / system / Main.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1999-05-03  |  3.3 KB  |  130 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.     StdCtrls, ComCtrls, ExtCtrls;
  8.  
  9. const
  10.     // Magic signatures
  11.     D2Magic  =         $50505348;
  12.     D3Magic  =         $44518641;
  13.     D4Magic  =         $4768A6D8;
  14.     B3Magic  =         $475896C8;
  15.  
  16.     // DCU record tags
  17.     Tag_End =         $61;
  18.  
  19. type
  20.     TForm1 = class(TForm)
  21.     Scan: TButton;
  22.     StatusBar1: TStatusBar;
  23.     TreeList: TListView;
  24.     procedure ScanClick(Sender: TObject);
  25.     private
  26.     { Private declarations }
  27.         Scanning: Boolean;
  28.         procedure ScanDrive (const Path: String);
  29.         procedure FoundOne (const PathName: String);
  30.     public
  31.       { Public declarations }
  32.     end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.  
  37. implementation
  38.  
  39. {$R *.DFM}
  40.  
  41. procedure TForm1.ScanClick (Sender: TObject);
  42. var
  43.     p: PChar;
  44.     szBuff: array [0..255] of Char;
  45. begin
  46.     Scanning := not Scanning;
  47.     if Scanning then begin
  48.         Scan.Caption := 'Stop Scan!';
  49.         Screen.Cursor := crHourGlass;
  50.         TreeList.Items.Clear;
  51.         TreeList.Items.BeginUpdate;
  52.  
  53.         try
  54.             p := szBuff;
  55.             GetLogicalDriveStrings (sizeof (szBuff), szBuff);
  56.             while Scanning and (p^ <> #0) do begin
  57.                 if GetDriveType (p) = Drive_Fixed then ScanDrive (p);
  58.                 Inc (p, 4);
  59.             end;
  60.         finally
  61.             Scanning := False;
  62.             Scan.Caption := 'Scan!';
  63.             Screen.Cursor := crDefault;
  64.             TreeList.Items.EndUpdate;
  65.         end;
  66.     end;
  67. end;
  68.  
  69. procedure TForm1.FoundOne (const PathName: String);
  70. var
  71.     eof: Byte;
  72.     S: String;
  73.     Valid: Boolean;
  74.     fs: TFileStream;
  75.     Item: TListItem;
  76.     Magic: array [0..2] of LongInt;
  77. begin
  78.     fs := TFileStream.Create (PathName, fmOpenRead);
  79.     try
  80.         fs.Read (Magic, sizeof (Magic));
  81.         fs.Position := fs.Size - 1;
  82.         fs.Read (eof, sizeof (eof));
  83.         Valid := (Magic [1] = fs.Size) and (eof = Tag_End);
  84.     finally
  85.         fs.Free;
  86.     end;
  87.  
  88.     if Valid then begin
  89.         Item := TreeList.Items.Add;
  90.         Item.Caption := PathName;
  91.         case Magic [0] of
  92.             D2Magic:   S := 'Delphi 2';
  93.             D3Magic:   S := 'Delphi 3';
  94.             D4Magic:   S := 'Delphi 4';
  95.             B3Magic:   S := 'C++ Builder 3';
  96.             else       S := '???' + IntToHex (Magic [0], 8);
  97.         end;
  98.         Item.SubItems.Add (S);
  99.  
  100.         if Magic [2] = $ffffffff then S := 'Invalid date/time' else
  101.         S := FormatDateTime ('dddd, mmmm d, yyyy, hh:mm AM/PM', FileDateToDateTime (Magic [2]));
  102.         Item.SubItems.Add (S);
  103.     end;
  104. end;
  105.  
  106. procedure TForm1.ScanDrive (const Path: String);
  107. var
  108.     Res: Integer;
  109.     SR: TSearchRec;
  110. begin
  111.     Application.ProcessMessages;
  112.     StatusBar1.Panels [0].Text := 'Scanning ' + Path;
  113.     Res := FindFirst (Path + '*.*', faAnyFile, SR);
  114.     try
  115.         while Scanning and (Res = 0) do begin
  116.             if SR.Name [1] <> '.' then begin
  117.                 if UpperCase (ExtractFileExt (SR.Name)) = '.DCU' then FoundOne (Path + SR.Name) else
  118.                 if ((SR.Attr and faDirectory) <> 0) then ScanDrive (Path + SR.Name + '\');
  119.             end;
  120.             Res := FindNext (SR);
  121.         end;
  122.     finally
  123.         FindClose (SR);
  124.     end;
  125. end;
  126.  
  127. end.
  128.  
  129.  
  130.